home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / compat.exe / COMPAT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-26  |  2KB  |  107 lines
  1. Unit COMPAT;
  2.  
  3. {$D+,B-,O+,R-,V-,X+ }
  4.  
  5. interface
  6.  
  7. uses
  8.     Dos, Crt, Objects, Drivers, Dialogs, Views, App, MsgBox;
  9.  
  10. type
  11.     PRunFunc    = ^TRunFunc;
  12.     TRunFunc    =  function : word;  { must be a FAR function }
  13.  
  14.     PFuncBox    = ^TFuncBox;
  15.     TFuncBox    =  OBJECT (TDialog)
  16.     RunFunc    : PRunFunc;
  17.       constructor Init (var Bounds :TRect; ATitle :TTitleStr; ARunFunc :PRunFunc);
  18.       destructor  Done;  VIRTUAL;
  19.       function  Execute : word;  VIRTUAL;
  20.       function  Valid (Command : word) : boolean;  VIRTUAL;
  21.     end;
  22.  
  23.  
  24.  
  25. implementation
  26.  
  27. var RF : PRunFunc;
  28.  
  29.   { ══ TFuncBox ══════════════════════════════════════════════════════════ }
  30.  
  31.  
  32. constructor TFuncBox.Init (var Bounds :TRect; ATitle :TTitleStr; ARunFunc :PRunFunc);
  33. begin
  34.   TDialog.Init (Bounds, ATitle);
  35.   RunFunc := ARunFunc;
  36.   Flags   := 0;
  37. end;
  38.  
  39.  
  40. destructor TFuncBox.Done;
  41. begin
  42.   TDialog.Done;
  43.   Application^.Redraw;
  44. end;
  45.  
  46.  
  47. function  TFuncBox.Execute : word;
  48. var  WMin,WMax, Result : word;
  49.      TAttr    : byte;
  50.     function  Localize (X,Y : integer) : word;
  51.     var pt : TPoint;
  52.     begin
  53.       pt.X := X;
  54.       pt.Y := Y;
  55.       MakeGlobal (pt, pt);
  56.       If (pt.X < 0) then pt.X := 0;
  57.       If (pt.Y < 0) then pt.Y := 0;
  58.       If (pt.X > pred (ScreenWidth)) then pt.X := pred (ScreenWidth);
  59.       If (pt.Y > pred (ScreenHeight)) then pt.Y := pred (ScreenHeight);
  60.       Localize := ((pt.Y and 255) shl 8) or (pt.X and 255)
  61.     end;
  62. begin
  63.   WMin       := WindMin;
  64.   WMax       := WindMax;
  65.   TAttr    := TextAttr;
  66.   WindMin  := Localize (1,1);
  67.   WindMax  := Localize ((Size.X - 2), (Size.Y - 2));
  68.   TextAttr := GetColor (6);
  69.   ClrScr;
  70.   CheckBreak   := FALSE;
  71.   CtrlBreakHit := FALSE;
  72.   Result := cmCancel;
  73.   If (RunFunc <> nil) then
  74.     begin
  75.     RF := RunFunc;
  76.     asm
  77.         mov   cx, CursorLines
  78.         mov   ah, 1
  79.         int   10h
  80.     call  RF;
  81.         mov   Result, ax;
  82.         mov   cx, 2000h
  83.         mov   ah, 1
  84.         int   10h
  85.     end;
  86.     end;
  87.   WindMin  := WMin;
  88.   WindMax  := WMax;
  89.   TextAttr := TAttr;
  90.   Execute  := Result;
  91. end;
  92.  
  93.  
  94. function  TFuncBox.Valid (Command : word) : boolean;
  95. var V : boolean;
  96. begin
  97.   V := Valid (Command);
  98.   If (Command = cmValid) and (RunFunc = nil) then V := FALSE;
  99.   Valid := V;
  100. end;
  101.  
  102.  
  103.   { ══════════════════════════════════════════════════════════════════════ }
  104.  
  105.  
  106. End.
  107.